COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	% scraps of code that will eventually be a complete base file
C00031 ENDMK
C⊗;
% scraps of code that will eventually be a complete base file
cmbase:=1; % when cmbase is known, this file has been input

let cmchar=\; % cmchar should precede each character, for testing purposes
let generate=input; % `generate' should follow the parameters

boolean square_dots,hefty,serifs,
 monospace,variant_g,low_asterisk,math_fitting;

newinternal slant,fudge,math_spread,superness,superpull,beak_darkness,ligs;

vardef serif(suffix $,$$,@)(expr darkness,jut) suffix modifier =
	% serif at |z$| for stroke from |z$$|
 pickup crisp.nib; numeric bracket_height; pair downward;
 bracket_height=if str modifier="dark": 1.5 fi bracket;
 if y$<y$$: y@2=min(y$+bracket_height,y$$);
  top y@1-slab=bot y@0=tiny.bot y$; downward=z$-z$$;
  if y@1>y@2: y@2:=y@1; fi
 else: y@2=max(y$-bracket_height,y$$);
  bot y@1+slab=top y@0=tiny.top y$; downward=z$$-z$;
  if y@1<y@2: y@2:=y@1; fi fi
 y@3=y@2; z@3=whatever[z$,z$$];
 if jut<0: z@2+penoffset downward of currentpen =
   z$l+penoffset downward of pen_[tiny.nib]+whatever*downward;
  lft x@0=lft x@1=tiny.lft x$l+jut; if x@3≤x@2: x@3:=x@3+epsilon; fi
 else: z@2-penoffset downward of currentpen =
   z$r-penoffset downward of pen_[tiny.nib]+whatever*downward;
   rt x@0=rt x@1=tiny.rt x$r+jut; if x@3≥x@2: x@3:=x@3-epsilon; fi fi
 pair corner; ypart corner=y@1; corner=z@2+whatever*(z$-z$$);
 filldraw z@2{z$-z$$}
  ...darkness[corner,.5[z@1,z@2] ]{z@1-z@2}
  ...{jut,0}z@1--z@0--(x$,y@0)--z@3--cycle; % the serif
 labels (@1,@2); enddef;

def cup_serif(suffix $,$$,@)(expr left_darkness,left_jut)
  (suffix @@)(expr right_darkness,right_jut) suffix modifier =
 serif($,$$,@,left_darkness,-left_jut) modifier;
 serif($,$$,@@,right_darkness,right_jut) modifier;
 if cup>0: pickup tiny.nib; numeric cup_out,cup_in;
  if y$<y$$: cup_out=bot y$; cup_in=cup_out+cup;
  else: cup_out=top y$; cup_in=cup_out-cup; fi
  erase fill (x@1,cup_out)..(x$,cup_in){right}..(x@@1,cup_out)--cycle;
 fi enddef;

vardef sloped_serif.l(suffix $,$$,@)(expr darkness,jut,drop) =
 pickup crisp.nib; penpos@2(slab-crisp,90);
 lft x@0=tiny.lft x$l; rt x@1=tiny.rt x$r;
 top y@1=tiny.top y$r;
 lft x@2=lft x@0-jut; y@2r=y@1-drop;
 y@0=max(y@2l-bracket,y$$)-epsilon;
 erase fill z@1--top z@1--(x@2r,top y@1)--z@2r--cycle; % erase excess at top
 filldraw z@1--z@2r--z@2l{right}
  ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  ...{down}z@0--(x@1,y@0)--cycle;	% sloped serif
 labels(@0,@1,@2); enddef;

vardef sloped_serif.r(suffix $,$$,@)(expr darkness,jut,drop) =
 pickup crisp.nib; penpos@2(slab-crisp,-90);
 rt x@0=tiny.rt x$r; lft x@1=tiny.lft x$l;
 bot y@1=tiny.bot y$l;
 rt x@2=rt x@0+jut; y@2r=y@1+drop;
 y@0=min(y@2l+bracket,y$$)+epsilon;
 erase fill z@1--bot z@1--(x@2r,bot y@1)--z@2r--cycle; % erase excess at bottom
 filldraw z@1--z@2r--z@2l{left}
  ...darkness[(x@0,y@2l),.5[z@2l,z@0] ]{z@0-z@2l}
  ...{up}z@0--(x@1,y@0)--cycle;	% sloped serif
 labels(@0,@1,@2); enddef;

vardef arm(suffix $,$$,@)(expr darkness,jut) =	% arm from |z$| to |z$$|
 x@0=good.x(x$$r-jut); y@0=y$r;
 if serifs: y@1=y$l; z@1=z$$l+whatever*(z$$r-z@0);
  z@2=.5[z$l,z@1];
  filldraw z$$l{z@1-z$$l}
   ...darkness[z@1,.5[z@2,z$$l] ]...z@2
   ---z$l--z$r--z@0--z$$r--cycle; % arm and beak
 else: filldraw z$l--z$r--z@0--z$$r--cycle; fi	% sans-serif arm
 penlabels(@0,@1,@2); enddef;

def bulb(suffix $,$$,$$$) = 
 z$$$r=z$$r;
 path_.l:=z$l{x$$r-x$r,0}...{0,y$$r-y$r}z$$l;
 filldraw path_.l--z$$r{0,y$r-y$$r}...{x$r-x$$r,0}z$r--cycle; % link
 path_.r:=z$$$l{0,y$r-y$$r}..z$$$r{0,y$$r-y$r}; % near-circle
 filldraw subpath(0,xpart(path_.r intersectiontimes path_.l)) of path_.r
  --z$$r{0,y$$r-y$r}..cycle; % bulb
 enddef;

def dot(suffix $,$$) =
 filldraw if square_dots: (x$l,y$$l)--(x$r,y$$l)
   --(x$r,y$$r)--(x$l,y$$r)--cycle	% squarish dot
  else: z$l...z$$l...z$r...z$$r...cycle	% roundish dot
 fi enddef;

def comma(suffix $,@)(expr dot_size,jut,depth) =
 pickup fine.nib; penpos$(dot_size-fine,90);
 if square_dots: penpos$'(dot_size-fine,0); z$'=z$; dot($',$);	% squarish dot
  comma_join_:=max(fine.breadth,floor .7dot_size);
  comma_bot_:=max(fine.breadth,floor .5dot_size);
  penpos@0(comma_join_-fine,0); penpos@1(comma_join_-fine,0);
  penpos@2(comma_bot_-fine,0); y@0=y$; y@1=y$l; y@2=y@1-depth;
  x@0r=x@1r=x$'r; rt x@2r=good.x(x$-epsilon);
  filldraw stroke z@0e--z@1e..z@2e;	% tail
 else: penpos@1(vair-fine,90); penpos@2(vair-fine,0); penpos@3(vair-fine,-45);
  z@1r=z$r; rt x@2r=round(x$+.5dot_size+jut); x@3=x$-.5u;
  y@2=1/3[y@1,y@3]; bot y@3r=round(y$-.5dot_size-depth);
  t_:=ypart((z@1{right}...z@2{down}...z@3) intersectiontimes
   (z$l{right}..{left}z$r)); if t_<0: t_:=1; fi
  filldraw z$r{left}..subpath (0,t_) of (z$l{right}..{left}z$r)--cycle; % dot
  filldraw stroke z@1e{right}...z@2e{down}...z@3e; fi	% tail
 penlabels(@1,@2,@3); enddef;

def ammoc(suffix $,@)(expr dot_size,jut,depth) = % reversed comma
 pickup fine.nib; penpos$(dot_size-fine,90);
 if square_dots: penpos$'(dot_size-fine,0); z$'=z$; dot($',$);	% squarish dot
  comma_join_:=max(fine.breadth,floor .7dot_size);
  comma_top_:=max(fine.breadth,floor .5dot_size);
  penpos@0(comma_join_-fine,0); penpos@1(comma_join_-fine,0);
  penpos@2(comma_top_-fine,0); y@0=y$; y@1=y$r; y@2=y@1+depth;
  x@0l=x@1l=x$'l; lft x@2l=good.x(x$+epsilon);
  filldraw stroke z@0e--z@1e..z@2e;	% tail
 else: penpos@1(vair-fine,90); penpos@2(vair-fine,0); penpos@3(vair-fine,-45);
  z@1l=z$l; lft x@2l=round(x$-.5dot_size-jut); x@3=x$+.5u;
  y@2=1/3[y@1,y@3]; top y@3l=round(y$+.5dot_size+depth);
  t_:=ypart((z@1{left}...z@2{up}...z@3) intersectiontimes
   (z$r{left}..{right}z$l)); if t_<0: t_:=1; fi
  filldraw z$l{right}..subpath (0,t_) of (z$r{left}..{right}z$l)--cycle; % dot
  filldraw stroke z@1e{left}...z@2e{up}...z@3e; fi	% tail
 penlabels(@1,@2,@3); enddef;

vardef diag_in(suffix from,$)(expr sharpness)(suffix $$) =
 pickup tiny.nib; save from_x,y_;
 if y.from>y$: bot else: top fi y_=y$;
 (from_x,y_)=whatever[z.from,z$];
 sharpness[z$,(from_x,y_)]{z$-z.from}
  ...{z$$-z$}z$+sharpness*length(z$-(from_x,y_))*unitvector(z$$-z$) enddef;

vardef diag_out(suffix $)(expr sharpness)(suffix $$,to) =
 pickup tiny.nib; save to_x,y_;
 if y.to>y$: bot else: top fi y_=y$;
 (to_x,y_)=whatever[z$$,z.to];
 z$$-sharpness*length(z$$-(to_x,y_))*unitvector(z$$-z$){z$$-z$}
  ...{z.to-z$$}sharpness[z$$,(to_x,y_)] enddef;

vardef diag_end(suffix from,$)(expr sharpness_in,sharpness_out)(suffix $$,to) =
 save from_x,to_x,y_,x_,xx_;
 if y.from>y$: tiny.bot else: tiny.top fi y_=y$; % we assume that |y$=y$$|
 (from_x,y_)=whatever[z.from,z$]; (to_x,y_)=whatever[z$$,z.to];
 if x$$>x$: x_=x$+sharpness_in*length(z$-(from_x,y_));
  xx_=x$$-sharpness_out*length(z$$-(to_x,y_));
  if xx_<x_: xx_:=x_:=.5[xx_,x_]; fi
 else: x_=x$-sharpness_in*length(z$-(from_x,y_));
  xx_=x$$+sharpness_out*length(z$$-(to_x,y_));
  if xx_>x_: xx_:=x_:=.5[xx_,x_]; fi fi
 sharpness_in[z$,(from_x,y_)]{z$-z.from}
  ...{z$$-z$}(x_,y$)..(xx_,y$){z$$-z$}
  ...{z.to-z$$}sharpness_out[z$$,(to_x,y_)] enddef;

def prime_points_inside(suffix $,$$) = 
 theta_:=angle(z$r-z$l);
 penpos$'(whatever,theta_);
 if y$$>y$: z$'=(0,pen_top) rotated theta_ + whatever[z$l,z$r];
  theta_:=angle(z$$-z$)-90;
 else: z$'=(0,pen_bot) rotated theta_ + whatever[z$l,z$r];
  theta_:=angle(z$$-z$)+90; fi
 z$'l+(pen_lft,0) rotated theta_=z$l+whatever*(z$-z$$);
 z$'r+(pen_rt,0) rotated theta_=z$r+whatever*(z$-z$$);
 enddef;

vardef parallel_pos(expr d,u,v,w) = % point at distance $d$ from $u$,
	% on the line through $w$ that's parallel to |u..v|
 pair p_; p_=w+whatever*(u-v)=u+whatever*(u-v) rotated 90;
 numeric d_; d_=length(u-p_);	% distance from $w$ to |u..v|
 if d_≥d: p_ else: p_+(d+-+d_)*unitvector(v-u) fi enddef;

def ellipse_set(suffix $,@,@@,$$) =
	% given |z$,x@,z$$|, find |y@,z@@| such that the path
	% |z${x@-x$,0}..z@{0,y@-y$}..{z$$-z@@}z@@| is consistent with an ellipse
	% and such that the line |z@@--z$$| has a given |slope|
 alpha_:=slope*(x@-x$); beta_:=y$$-y$-slope*(x$$-x$); gamma_:=alpha_/beta_;
 y@-y$=.5(beta_-alpha_*gamma_);
 x@@-x$=-2gamma_*(x@-x$)/(1+gamma_*gamma_); y@@-y$$=slope*(x@@-x$$) enddef;

vardef diag_ratio(expr a,b,y,c) =
	% the value $\alpha=(x++y)/y$ such that $ax+b\alpha=c$,
	% assuming that $a>\vert b/y\vert$
 numeric a_,b_; b_=b/y; a_=a*a-b_*b_;
 (a*(c++y*sqrt a_)-b_*c)/a_/y enddef;
%vardef solve_diag(expr a,b,y,c) =
%	% the root of $ax+b(x++y)/y=c$, assuming that $a>\vert b/y\vert$
% numeric a_,b_; b_=b/y; a_=a*a-b_*b_;
% (a*c-b_*(c++y*sqrt a_))/a_ enddef;

def f_stroke(suffix $,$$,@,left_serif,right_serif)(expr left_jut,right_jut)=
 pickup tiny.nib; bot y$=0;
 penpos@0(x$r-x$l,0); x@0l=x$l; top y@0=x_height;
 filldraw stroke z$e..z@0e;	% stem
 pickup fine.nib; penpos@0'(x$r-x$l-round(stem_corr)+tiny-fine,180);
 y@0'=y@0; lft x@0'r=tiny.lft x$l;
 penpos@1(x@0'l-x@0'r,180); x@1=x@0'; y@1+.5vair=.5[x_height,h];
 penpos@2(vair-fine,90); top y@2r=h+oo;
 if serifs: x@2=.6[x@1,x$$r]; (x@,y@2r)=whatever[z@2l,z@1l]; x@2r:=x@;
  penpos@3(hair-fine,0); bulb(@2,@3,$$);	% bulb
  filldraw stroke z@0'e..z@1e & super_arc.e(@1,@2);	% arc
  cup_serif($,@0,left_serif,1/3,left_jut,right_serif,1/3,right_jut); % serif
 else: x@2=.6[x@1,x$$]; y@1l:=1/3[y@1l,y@2l];
  filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2)
   & z@2e{right}..tension atleast .9 and 1..z$$e; fi	% arc and terminal
 penlabels(@0,@1,@2); enddef;

def h_stroke(suffix $,@,@@,$$) =
 penpos$$(x@@r-x@@l,0); x$$=x@@; bot y$$=0; y@@=1/3[bar_height,x_height];
 penpos$''(x$r-x$l,0); x$''=x$; y$''=1/8[bar_height,x_height];
 filldraw stroke z$''e..z$e;	% thicken the lower left stem
 pickup fine.nib; penpos@0(thin_join-fine,180);
 rt x@0l=tiny.rt x$r; y@0=y$'';
 penpos@1(vair-fine,90); penpos@@'(x@@r-x@@l+tiny-fine,0); z@@'=z@@;
 x@1=.5[rt x@0l,rt x@@'r]; top y@1r=x_height+oo;
 (x@,y@1l)=whatever[z@1r,z@0l]; x@1l:=x@;
 filldraw stroke z@0e{up}...{right}z@1e
  &{{interim superness:=hein_super;
   pulled_super_arc.e(@1,@@')(superpull)}};	% arch
 pickup tiny.nib; filldraw stroke z@@e..z$$e;	% right stem
 labels(@0); penlabels(@1); enddef;

def compute_spread(expr normal_spread,big_spread)=
 spread#:=math_spread[normal_spread,big_spread];
 spread:=ceiling(spread#*hppp)+4epsilon; enddef;

def v_center(expr h_sharp) =
 .5h_sharp+math_axis#, .5h_sharp-math_axis# enddef;

def beginarithchar(expr c) = % ensure consistent heights and depths
  % for the common arithmetic operators (plus, minus, times, \dots)
 if monospace: beginchar(c,9u#,3.5u#+math_axis#,3.5u#-math_axis#);
 else: beginchar(c,14u#,6u#+math_axis#,6u#-math_axis#); fi
 italcorr math_axis#*slant-.5u#;
 adjust_fit(0,0); less_rounded; enddef;

newinternal shrink_fit;

def normal_adjust_fit(expr left_adjustment,right_adjustment) =
 l:=-round(left_adjustment*hppp)-letter_fit;
	% double rounding makes letter spacing more consistent
 interim xoffset:=-l;
 charwd:=charwd+2letter_fit#+left_adjustment+right_adjustment;
% r:=l+round(charwd*hppp); TEMPORARILY CHANGED!
 r:=l+round(charwd*hppp)-shrink_fit;
 w:=r-round(right_adjustment*hppp)-letter_fit;
 enddef;

def mono_adjust_fit(expr left_adjustment,right_adjustment) =
 numeric expansion_factor;
 mono_charwd#=2letter_fit#
   +expansion_factor*(charwd+left_adjustment+right_adjustment);
 forsuffixes $=u,jut,cap_jut,beak_jut,apex_corr:
   $:=$.#*expansion_factor*hppp; endfor
 l:=-round(left_adjustment*expansion_factor*hppp)-letter_fit;
 interim xoffset:=-l;
% r:=l+mono_charwd; TEMPORARILY CHANGED!
 r:=l+mono_charwd-shrink_fit;
 w:=r-round(right_adjustment*expansion_factor*hppp)-letter_fit;
 charwd:=mono_charwd#; charic:=mono_charic#;
 enddef;

% extra_endchar:=extra_endchar&"w:=r-l;"; TEMPORARILY CHANGED!
extra_endchar:=extra_endchar&"r:=r+shrink_fit;w:=r-l;";
extra_setup:=extra_setup&"shrink_fit:=if mode>smoke:1 else: 0 fi;";

def ignore_math_fit(expr left_adjustment,right_adjustment) = enddef;
def do_math_fit(expr left_adjustment,right_adjustment) = % not tested!
 l:=l-round(left_adjustment*hppp);
 charwd:=charwd+left_adjustment+right_adjustment;
 r:=l+round(charwd);
 charic:=charic-right_adjustment;
 if charic<0: charic:=0; fi enddef;

def font_setup =
 define_pixels(u,width_adj,serif_fit,cap_serif_fit,jut,cap_jut,beak,
  bar_height,cup,bracket,beak_jut,stem_corr,vair_corr,apex_corr);
 define_blacker_pixels(ess,cap_ess,notch_cut,cap_notch_cut);
 define_whole_pixels(letter_fit,thin_join,fine,crisp,tiny);
 define_whole_vertical_pixels(body_height,asc_height,
  cap_height,fig_height,x_height,comma_depth,desc_depth,serif_drop);
 define_whole_blacker_pixels(hair,vair,bar,slab,stem,curve,
  flare,dot_size,cap_hair,cap_bar,cap_band,cap_stem,cap_curve);
 define_corrected_pixels(o,apex_o);
 forsuffixes $=hair,stem,cap_stem:
  fudged$.#:=fudge*$.#; fudged$:=round(fudged$.#*hppp+blacker);
  forever: exitif fudged$>.9fudge*$; fudged$:=fudged$+1; endfor endfor
 rule_thickness:=ceiling(rule_thickness#*hppp);
 oo:=round(.5o#*hppp*o_correction)+epsilon;
 apex_oo:=round(.5apex_o#*hppp*o_correction)+epsilon;
 if monospace: let adjust_fit=mono_adjust_fit;
  def mfudged=fudged enddef;
  mono_charic#:=body_height#*slant;
  if mono_charic#<0: mono_charic#:=0; fi
  mono_charwd#:=9u#+2letter_fit#; define_whole_pixels(mono_charwd);
 else: let adjust_fit=normal_adjust_fit;
  def mfudged= enddef; fi
 if math_fitting: let math_fit=do_math_fit
 else: let math_fit=ignore_math_fit fi;
 lowres_fix(stem,curve,flare) 1.3;
 lowres_fix(stem,curve) 1.2;
 lowres_fix(cap_stem,cap_curve) 1.2;
 lowres_fix(hair,cap_hair) 1.2;
 lowres_fix(cap_band,cap_bar,bar,slab) 1.2;
 stem':=round(stem-stem_corr); cap_stem':=round(cap_stem-stem_corr);
 stem'':=round(stem-2stem_corr); cap_stem'':=round(cap_stem-2stem_corr);
 vair':=round(vair+vair_corr);
 more_super:=max(superness,sqrt .77superness);
 hein_super:=max(superness,sqrt .81225258superness); % that's $2↑{-.3}$
 forsuffixes $=fine,crisp,tiny:
  if $>fudged.hair: $:=fudged.hair; fi
  $.breadth:=$;
  pickup if $=0: nullpen
  else: pencircle scaled $; $:=$-3epsilon fi;
  $.nib:=savepen;
  forsuffixes $$=rt,lft,bot,top: shiftdef($.$$,$$ 0); endfor endfor
 pickup pencircle scaled rule_thickness; rule.nib:=savepen;
 math_axis:=good.y(math_axis#*hppp);
 numeric body_depth#; .5[body_height#,-body_depth#]=math_axis#;
 currenttransform:=identity slanted slant yscaled aspect_ratio;
 body_depth:=desc_depth+body_height-asc_height;
 enddef;

def shiftdef(suffix $)(expr delta) =
 vardef $ primary x = x+delta enddef enddef;

% this for efficiency only; worth it? (I guess it goes into PLAIN someday)
vardef penpos@#(expr b,d) =
 (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d;
 x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;

def makebox(text rule) =
 for y=0,asc_height,body_height,x_height,bar_height,-desc_depth,-body_depth:
  rule(↑(l,y),↑(r,y)); endfor % horizontals
 for x=l,r:   rule(↑(x,-body_depth),↑(x,body_height)); endfor % verticals
 for x=u*(1+floor(l/u)) step u until r-1:
  rule(↑(x,-body_depth),↑(x,body_height)); endfor % more verticals
 if charic≠0: rule((r+charic*pt,h!),(r+charic*pt,.5h!)); fi % italic correction
 enddef;
def maketicks(text rule) =
 for y=0,h!,-d!: rule((l,y),(l+10,y)); rule((r-10,y),(r,y)); endfor % horizontals
 for x=l,r: rule((x,10-d!),(x,-d!)); rule((x,h!-10),(x,h!)); endfor % verticals
 enddef;
rulepen:=pensquare;

vardef stroke text t =
 forsuffixes e = l,r: path_.e:=t; endfor
 if cycle path_.l: errmessage "Beware: `stroke' isn't intended for cycles"; fi
 path_.l -- reverse path_.r -- cycle enddef;

vardef super_arc.r(suffix $,$$) = % outside of super-ellipse
 pair center,corner;
 if y$=y$r: center=(x$$r,y$r); corner=(x$r,y$$r);
 else: center=(x$r,y$$r); corner=(x$$r,y$r); fi
 z$.r{corner-z$.r}...superness[center,corner]{z$$.r-z$.r}
% hide(makelabel("r",superness[center,corner]))	% temporary
  ...{z$$.r-corner}z$$.r enddef;

vardef super_arc.l(suffix $,$$) = % inside of super-ellipse
 pair center,corner;
 if y$=y$r: center=(x$$l,y$l); corner=(x$l,y$$l);
 else: center=(x$l,y$$l); corner=(x$$l,y$l); fi
 z$l{corner-z$l}...superness[center,corner]{z$$l-z$l}
% hide(makelabel("l",superness[center,corner])) % temporary
  ...{z$$l-corner}z$$l enddef;

vardef pulled_super_arc.r(suffix $,$$)(expr superpull) =
 pair center,corner;
 if y$=y$r: center=(x$$r,y$r); corner=(x$r,y$$r);
 else: center=(x$r,y$$r); corner=(x$$r,y$r); fi
 z$r{corner-z$r}...superness[center,corner]{z$$r-z$r}
% hide(makelabel("r",superness[center,corner])) % temporary
  ...{z$$r-corner}z$$r enddef;

vardef pulled_super_arc.l(suffix $,$$)(expr superpull) =
 pair center,corner,outer_point;
 if y$=y$r: center=(x$$l,y$l); corner=(x$l,y$$l);
  outer_point=superness[(x$$r,y$r),(x$r,y$$r)];
 else: center=(x$l,y$$l); corner=(x$$l,y$l);
  outer_point=superness[(x$r,y$$r),(x$$r,y$r)]; fi
 z$l{corner-z$l}
  ...superpull[superness[center,corner],outer_point]{z$$l-z$l}
% hide(makelabel("l",superpull[superness[center,corner],outer_point])) % temporary
  ...{z$$l-corner}z$$l enddef;

let {{=begingroup; let }}=endgroup;
def .... = .. tension atleast .9 .. enddef;
def less_rounded = interim autorounding:=1 enddef;

vardef ic# = charic enddef;
vardef h# = charht enddef;

let semi_ = ;; let colon_ = :; let endchar_ = endchar;
def iff expr b = if b:let next_=use_it else:let next_=lose_it fi; next_ enddef;
def use_it = let : = restore_colon; enddef;
def restore_colon = let : = colon_; enddef;
def lose_it = let endchar=fi; let ;=restore_endchar semi_ if false enddef;
def restore_endchar=let ;=semi_; let endchar=endchar_; enddef;
def always_iff expr b = use_it enddef;

% TEMPORARY PATCH WHILE DEBUGGING
vardef penpos@#(expr b,d) =
 if known b: if b<=0: errmessage "bad penpos"; fi fi
 z@#r-z@#l=(b,0) rotated d; z@#=.5[z@#l,z@#r] enddef;